home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 19 / madtrb11.zip / TYPER.PAS < prev    next >
Pascal/Delphi Source File  |  1985-07-13  |  4KB  |  149 lines
  1. Program TYPER;
  2.  
  3. {
  4. This program is a typewriter emulator for systems with character-based
  5. line printers. Tabs and backspaces are permitted; each line will be
  6. auto-indented, similar to the ^QI option in the Turbo Pascal editor.
  7.  
  8. Source: "TYPER: A Typewriter Emulator", TUG Lines Volume I, Issue 4
  9. Author: L.P. Levine/Milwaukee, WI/
  10. Application: All operating systems
  11. }
  12.  
  13. const
  14.  version_flag = '103184';
  15.  
  16. var
  17.  i,firstchar:integer;
  18.  new_character:char;
  19.  text_line:string[100];
  20.  
  21. function inkey:char;      { read a single character from the keyboard }
  22.  
  23. var
  24.  inkeytemp:char;
  25.  
  26. begin
  27.  read(kbd,inkeytemp);
  28.  inkey := inkeytemp;
  29. end;
  30.  
  31. procedure typewriter_init;
  32.  
  33. begin
  34.                           { insert printer initialization here, if needed }
  35.  
  36. end;
  37.  
  38. procedure print_out(outchar:char);
  39.                           { print a single character to the printer       }
  40.  
  41. begin
  42.  write(lst,outchar);
  43. end;
  44.  
  45. { Program main body }
  46.  
  47. begin
  48.  { Initialization }
  49.  ClrScr;
  50.  GotoXY(1,1);
  51.  HighVideo;
  52.  write('          ');
  53.  LowVideo;
  54.  write('Typewriter Emulator, Version ',version_flag,'. ');
  55.  writeln('Type CTRL-C to Exit.');
  56.  HighVideo;
  57.  GotoXY(1,4);
  58.  typewriter_init;  {Initialize the printer}
  59.  text_line := '';
  60.  firstchar := 1;
  61.  { Loop Routine }
  62.  {accept a character and print it, end with CTRL-C}
  63.  while ord(new_character) <> 3 do begin
  64.     new_character := inkey;
  65.     case new_character of
  66.     #127,#8: {Rubout,Backspace; erase the last character, and print
  67.               out a BS SP BS.}
  68.       begin
  69.        if length(text_line) > 0 then
  70.         begin
  71.          text_line := copy(text_line,1,length(text_line)-1);
  72.          print_out(#8);
  73.          write(#8,' ',#8)
  74.         end;
  75.       end;
  76.     #13:      {Carriage Return; Print the string out}
  77.       begin
  78.        writeln;
  79.        {write a colon, to show system busy. }
  80.        write(':');
  81.        print_out(#13);
  82.        i := 1;
  83.        {print out the line.                 }
  84.        while i <= length(text_line) do
  85.         begin
  86.          print_out(copy(text_line,i,1));
  87.          i := i + 1
  88.         end;
  89.        {find the first non-blank, and tab to it.}
  90.        i := length(text_line);
  91.        while i <> 0 do
  92.         begin
  93.          if copy(text_line,i,1) <> ' ' then firstchar := i;
  94.          i := i - 1
  95.         end;
  96.        text_line := '';
  97.        i := 1;
  98.        print_out(#13); {carriage return}
  99.        print_out(#10); {line feed}
  100.        {erase the colon and space out.          }
  101.        write(#8,' ',#8);
  102.        while i < firstchar do
  103.         begin
  104.          write(' ');
  105.          print_out(' ');
  106.          text_line := text_line + ' ';
  107.          i := i + 1
  108.         end;
  109.       end;
  110.  
  111.     #9:           {Horizontal tabulation}
  112.      begin
  113.       write(' ');
  114.       print_out(' ');
  115.       text_line := text_line + ' ';
  116.       while length(text_line) mod 8 <> 0 do
  117.        begin
  118.         text_line := text_line + ' ';
  119.         write(' ');
  120.         print_out(' ')
  121.        end;
  122.      end;
  123.  
  124.     #3:           {Control - C}
  125.      begin
  126.       writeln;
  127.       print_out(#13);
  128.       print_out(#10);
  129.       print_out(#7);
  130.       GotoXY(1,24)
  131.      end;
  132.  
  133.     #0..#31:
  134.      begin
  135.      {Treat all other control characters as nulls.}
  136.      end;
  137.  
  138.     else          {Accept all other characters}
  139.      begin
  140.       write(new_character);
  141.       text_line := text_line + new_character;
  142.       print_out(' ');
  143.      end  { write a single character to screen }
  144.     end   {character case  }
  145.    end   {while not CTRL-C}
  146. end.
  147.  
  148.  
  149.